home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0031_Various SINUS Graphics.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  10.5 KB  |  528 lines
  1. {$g+}  { see end of document for more .. }
  2. uses
  3.   crt,gru;  { GRU in GRAPHICS.SWG }
  4. const
  5.   add1=1;
  6.   add2=-1;
  7.   add3=-1;
  8. var
  9.   ptab,ctab:array[0..199] of byte;
  10.   stab1,stab2,stab3:array[0..255] of byte;
  11.   i,i1,i2,i3:word;
  12.   workp:pointer;
  13.   work:word;
  14.   timer:longint absolute $0040:$006c;
  15.   frame,t1,t2:longint;
  16.  
  17. procedure virtup;
  18. begin
  19.   getmem(workp,64000);
  20.   work:=seg(workp^);
  21. end;
  22.  
  23. procedure virtdn;
  24. begin
  25.   work:=0;
  26.   freemem(workp,64000);
  27. end;
  28.  
  29. procedure init;
  30. begin
  31.   virtup;
  32.   frame:=0;
  33.   for i:=0 to 255 do begin
  34.     stab1[i]:=round(sin(i*2*pi/255)*50)+160;
  35.     stab2[i]:=round(cos(i*4*pi/255)*25);
  36.     stab3[i]:=round(sin(i*4*pi/255)*25);
  37.   end;
  38.   fillchar(ctab,sizeof(ctab),0);
  39.   i1:=0; i2:=25; i3:=100;
  40. end;
  41.  
  42. procedure waves;
  43. var x,y:word;
  44. begin
  45.   t1:=timer;
  46.   repeat
  47.     move(ctab,ptab,sizeof(ctab));
  48.     for i:=0 to 199 do
  49.     begin
  50.       ctab[i]:=stab1[(i+i1) mod 255]+stab2[(i+i2) mod 255]+stab3[(i+i3) mod 255];
  51.       hline2(0,ctab[i],i,work,ctab[i]-59);
  52.       hline2(ctab[i],320,i,work,not (ctab[i]-15));
  53.     end;
  54.     i1:=(i1+add1) mod 255; i2:=(i2+add2) mod 255; i3:=(i3+add3) mod 255;
  55.     flip386(work,vidseg);
  56.     inc(frame);
  57.   until(keypressed)and(readkey=#27);
  58.   t2:=(timer-t1);
  59. end;
  60.  
  61. procedure main;
  62. begin
  63.   init;
  64.   setmode($13);
  65.   for i:=1 to 199 do setpal(i,i div 4,20+i div 5,10+i div 6);
  66.   waves;
  67.   setmode($03);
  68.   writeln(round((frame*18.2)/t2),' fps.');
  69.   virtdn;
  70. end;
  71.  
  72. begin
  73.   main;
  74. end.
  75.  
  76. {---------------------------  SIN2 -------------------- }
  77.  
  78. {$g+}
  79. uses
  80.   crt,gru;
  81. const
  82.   add1=1;
  83.   add2=-1;
  84.   add3=-1;
  85. var
  86.   ptab,ctab:array[0..319] of byte;
  87.   stab1,stab2,stab3:array[0..255] of byte;
  88.   i,i1,i2,i3:word;
  89.   workp:pointer;
  90.   work:word;
  91.   timer:longint absolute $0040:$006c;
  92.   frame,t1,t2:longint;
  93.  
  94. procedure virtup;
  95. begin
  96.   getmem(workp,64000);
  97.   work:=seg(workp^);
  98. end;
  99.  
  100. procedure virtdn;
  101. begin
  102.   work:=0;
  103.   freemem(workp,64000);
  104. end;
  105.  
  106. procedure init;
  107. begin
  108.   virtup;
  109.   frame:=0;
  110.   for i:=0 to 255 do
  111.   begin
  112.     stab1[i]:=round(sin(i*2*pi/255)*50)+109;
  113.     stab2[i]:=round(cos(i*4*pi/255)*25);
  114.     stab3[i]:=round(sin(i*4*pi/255)*25);
  115.   end;
  116.   fillchar(ctab,sizeof(ctab),0);
  117.   i1:=0; i2:=25; i3:=100;
  118. end;
  119.  
  120. procedure waves;
  121. var x,y:word;
  122. begin
  123.   t1:=timer;
  124.   repeat
  125.     move(ctab,ptab,sizeof(ctab));
  126.     for i:=0 to 319 do
  127.     begin
  128.       ctab[i]:=stab1[(i+i1) mod 255]+stab2[(i+i2) mod 255]+stab3[(i+i3) mod 255];
  129.       vline2(i,0,ctab[i],work,ctab[i]);
  130.       vline2(i,ctab[i],200,work,not (ctab[i]+40));
  131.     end;
  132.     i1:=(i1+add1) mod 255; i2:=(i2+add2) mod 255; i3:=(i3+add3) mod 255;
  133.     flip386(work,vidseg);
  134.     inc(frame);
  135.   until(keypressed)and(readkey=#27);
  136.   t2:=(timer-t1);
  137. end;
  138.  
  139. procedure main;
  140. begin
  141.   init;
  142.   setmode($13);
  143.   for i:=1 to 199 do setpal(i,i div 4,20+i div 5,10+i div 6);
  144.   waves;
  145.   setmode($03);
  146.   writeln('SiNUS iNTRO ][ CODED BY Z00NE/MARCHERSOFT');
  147.   writeln(round((frame*18.2)/t2),' fps.');
  148.   virtdn;
  149. end;
  150.  
  151. begin
  152.   main;
  153. end.
  154.  
  155. { ------------------ SIN3 ---------------------- }
  156.  
  157. {$g+}
  158. uses
  159.   crt,gru;
  160. const
  161.   add1=1;
  162.   add2=-1;
  163.   add3=-1;
  164. var
  165.   ptab,ctab:array[0..319] of byte;
  166.   stab1,stab2,stab3:array[0..255] of byte;
  167.   i,i1,i2,i3:word;
  168.   workp:pointer;
  169.   work:word;
  170.   timer:longint absolute $0040:$006c;
  171.   frame,t1,t2:longint;
  172.  
  173. procedure virtup;
  174. begin
  175.   getmem(workp,64000);
  176.   work:=seg(workp^);
  177. end;
  178.  
  179. procedure virtdn;
  180. begin
  181.   work:=0;
  182.   freemem(workp,64000);
  183. end;
  184.  
  185. procedure init;
  186. begin
  187.   virtup;
  188.   frame:=0;
  189.   for i:=0 to 255 do begin
  190.     stab1[i]:=round(sin(i*2*pi/255)*50)+109;
  191.     stab2[i]:=round(cos(i*4*pi/255)*25);
  192.     stab3[i]:=round(sin(i*4*pi/255)*25);
  193.   end;
  194.   fillchar(ctab,sizeof(ctab),0);
  195.   i1:=0; i2:=25; i3:=100;
  196. end;
  197.  
  198. procedure waves;
  199. var x,y:word;
  200. begin
  201.   t1:=timer;
  202.   repeat
  203.     move(ctab,ptab,sizeof(ctab));
  204.     for i:=0 to 319 do
  205.     begin
  206.       ctab[i]:=stab1[(i+i1) mod 255]+stab2[(i+i2) mod 255]+stab3[(i+i3) mod 255];
  207.       vline2(i,0,ctab[i],work,ctab[i]);
  208.       vline2(i,ctab[i],200,work,not (ctab[i]+40));
  209.       smooth1(i-1,ctab[i]-1,work);
  210.       smooth1(i-1,ctab[i],work);
  211.       smooth1(i-1,ctab[i]-1,work);
  212.       smooth1(i+1,ctab[i]+1,work);
  213.       smooth1(i+1,ctab[i],work);
  214.       smooth1(i,ctab[i]+1,work);
  215.       smooth1(i-1,ctab[i]+1,work);
  216.       smooth1(i+1,ctab[i]-1,work);
  217.       smooth1(i,ctab[i],work);
  218.     end;
  219.     i1:=(i1+add1) mod 255; i2:=(i2+add2) mod 255; i3:=(i3+add3) mod 255;
  220.     flip386(work,vidseg);
  221.     inc(frame);
  222.   until(keypressed)and(readkey=#27);
  223.   t2:=(timer-t1);
  224. end;
  225.  
  226. procedure main;
  227. begin
  228.   init;
  229.   setmode($13);
  230.   for i:=1 to 199 do setpal(i,i div 4,20+i div 5,10+i div 6);
  231.   waves;
  232.   setmode($03);
  233.   writeln('SiNUS iNTRO ]I[ CODED BY Z00NE/MARCHERSOFT');
  234.   writeln(round((frame*18.2)/t2),' fps.');
  235.   virtdn;
  236. end;
  237.  
  238. begin
  239.   main;
  240. end.
  241.  
  242. { ------------------------  SIN 4 -------------------- }
  243. {$g+,r-,x-,o-,s-,q-,d-,l-,y-,a+,e-,n-,p-,t-,v-,y-}
  244. uses
  245.   crt,gru;
  246. const
  247.   add1=1;
  248.   add2=-1;
  249.   add3=-1;
  250.   sofs=75;
  251.   samp=75;
  252.   slen=255;
  253.   sprpic:array[0..15,0..15]of byte=(
  254.     (0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0),
  255.     (0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0),
  256.     (0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0),
  257.     (0,0,1,1,1,1,1,2,2,1,1,1,1,1,0,0),
  258.     (0,1,1,1,1,1,2,2,2,2,1,1,1,1,1,0),
  259.     (0,1,1,1,1,2,2,3,3,2,2,1,1,1,1,0),
  260.     (1,1,1,1,2,2,3,3,3,3,2,2,1,1,1,1),
  261.     (1,1,1,1,2,2,3,4,4,3,2,2,1,1,1,1),
  262.     (1,1,1,1,2,2,3,3,3,3,2,2,1,1,1,1),
  263.     (0,1,1,1,1,2,2,3,3,2,2,1,1,1,1,0),
  264.     (0,1,1,1,1,1,2,2,2,2,1,1,1,1,1,0),
  265.     (0,0,1,1,1,1,1,2,2,1,1,1,1,1,0,0),
  266.     (0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0),
  267.     (0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0),
  268.     (0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0),
  269.     (0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0));
  270. type
  271.   sinarray=array[0..slen]of word;
  272. var
  273.   stab:sinarray; { Used to move shade bob. }
  274.   ptab,ctab:array[0..319] of byte;
  275.   stab1,stab2,stab3:array[0..255] of byte;
  276.   i,i1,i2,i3:word;
  277.   workp:pointer;
  278.   work:word;
  279.   timer:longint absolute $0040:$006c;
  280.   frame,t1,t2:longint;
  281.  
  282. procedure virtup;
  283. begin
  284.   getmem(workp,64000);
  285.   work:=seg(workp^);
  286. end;
  287.  
  288. procedure virtdn;
  289. begin
  290.   work:=0;
  291.   freemem(workp,64000);
  292. end;
  293.  
  294. procedure init;
  295. begin
  296.   virtup;
  297.   for i:=0 to slen do stab[i]:=round(sin(i*4*pi/slen)*samp)+sofs;
  298.   for i:=0 to 255 do
  299.   begin
  300.     stab1[i]:=round(sin(i*2*pi/255)*50)+109;
  301.     stab2[i]:=round(cos(i*4*pi/255)*25);
  302.     stab3[i]:=round(sin(i*4*pi/255)*25);
  303.   end;
  304.   fillchar(ctab,sizeof(ctab),0);
  305.   i1:=0; i2:=25; i3:=100;
  306. end;
  307.  
  308. procedure waves;
  309. var
  310.   c,x,y:word;
  311.   i,j:byte;
  312. begin
  313.   t1:=timer;
  314.   i:=0;
  315.   j:=25;
  316.   c:=0;
  317.   clear386(work,0);
  318.   repeat
  319.     if(c>4)then
  320.     begin
  321.       c:=0;
  322.       smooth(work);
  323.       line2(160,100,x,y,work,i);
  324.     end;
  325.     x:=2*stab[i];
  326.     y:=stab[j];
  327.     inc(i);
  328.     inc(j);
  329.     drawsprite(x,y,work,16,16,0,sprpic);
  330.     line2(0,0,319,0,work,0);
  331.     line2(0,0,0,199,work,0);
  332.     line2(0,199,319,199,work,0);
  333.     line2(319,199,319,0,work,0);
  334.     flip386(work,vidseg);
  335.     inc(c);
  336.   until(keypressed);
  337.   t2:=(timer-t1);
  338. end;
  339.  
  340. procedure main;
  341. begin
  342.   init;
  343.   setmode($13);
  344.   for i:=1 to 199 do setpal(i,i div 4,20+i div 5,10+i div 6);
  345.   waves;
  346.   setmode($03);
  347.   writeln('SiNUS iNTRO iV CODED BY Z00NE/MARCHERSOFT');
  348.   writeln(round((frame*18.2)/t2),' fps.');
  349.   virtdn;
  350. end;
  351.  
  352. begin
  353.   main;
  354. end.
  355.  
  356. { ----------------------------  SIN 5 ---------------------- }
  357. {$g+}
  358. uses
  359.   crt,gru;
  360. const
  361.   add1=1;
  362.   add2=-1;
  363.   add3=-1;
  364. var
  365.   ptab,ctab:array[0..319] of byte;
  366.   stab1,stab2,stab3:array[0..255] of byte;
  367.   i,i1,i2,i3:word;
  368.   workp:pointer;
  369.   work:word;
  370.   timer:longint absolute $0040:$006c;
  371.   frame,t1,t2:longint;
  372.  
  373. procedure virtup;
  374. begin
  375.   getmem(workp,64000);
  376.   work:=seg(workp^);
  377. end;
  378.  
  379. procedure virtdn;
  380. begin
  381.   work:=0;
  382.   freemem(workp,64000);
  383. end;
  384.  
  385. procedure init;
  386. begin
  387.   virtup;
  388.   frame:=0;
  389.   for i:=0 to 255 do
  390.   begin
  391.     stab1[i]:=round(sin(i*2*pi/255)*50)+109;
  392.     stab2[i]:=round(cos(i*4*pi/255)*25);
  393.     stab3[i]:=round(sin(i*4*pi/255)*25);
  394.   end;
  395.   fillchar(ctab,sizeof(ctab),0);
  396.   i1:=0; i2:=25; i3:=100;
  397. end;
  398.  
  399. procedure waves;
  400. var x,y:word;
  401. begin
  402.   t1:=timer;
  403.   repeat
  404.     move(ctab,ptab,sizeof(ctab));
  405.     for i:=0 to 319 do
  406.     begin
  407.       ctab[i]:=stab1[(i+i1) mod 255]+stab2[(i+i2) mod 255]+stab3[(i+i3) mod 255];
  408.       vline2(i,0,200,work,ctab[i]);
  409.       vline2(i,ctab[i]-5,ctab[i]+5,work,not(ctab[i]+40));
  410.     end;
  411.     i1:=(i1+add1) mod 255; i2:=(i2+add2) mod 255; i3:=(i3+add3) mod 255;
  412.     flip386(work,vidseg);
  413.     inc(frame);
  414.   until(keypressed)and(readkey=#27);
  415.   t2:=(timer-t1);
  416. end;
  417.  
  418. procedure main;
  419. begin
  420.   init;
  421.   setmode($13);
  422.   for i:=1 to 199 do setpal(i,i div 4,20+i div 5,10+i div 6);
  423.   waves;
  424.   setmode($03);
  425.   writeln('SiNUS iNTRO V CODED BY Z00NE/MARCHERSOFT');
  426.   writeln(round((frame*18.2)/t2),' fps.');
  427.   virtdn;
  428. end;
  429.  
  430. begin
  431.   main;
  432. end.
  433. { ---------------------  SIN 6   --------------------- }
  434.  
  435.  
  436. {$g+,d-,l-,y-,n-,e-,r-,s-,q-,t-,v-,x-}
  437. uses gru;
  438. const
  439.   add1=1;
  440.   add2=-1;
  441.   add3=-1;
  442. var
  443.   ptab,ctab:array[0..199] of byte;
  444.   stab1,stab2,stab3:array[0..255] of byte;
  445.   i,i1,i2,i3:word;
  446.   workp:pointer;
  447.   work:word;
  448.   timer:longint absolute $0040:$006c;
  449.   frame,t1,t2:longint;
  450.  
  451. function readkey:char; assembler;
  452. asm
  453.   xor ah,ah
  454.   int 16h
  455. end;
  456.  
  457. function keypressed:boolean; assembler;
  458. asm
  459.   mov ah, 01h
  460.   int 16h
  461.   mov ax, 00h
  462.   jz @1
  463.   inc ax
  464.   @1:
  465. end;
  466.  
  467. procedure virtup;
  468. begin
  469.   getmem(workp,64000);
  470.   work:=seg(workp^);
  471. end;
  472.  
  473. procedure virtdn;
  474. begin
  475.   work:=0;
  476.   freemem(workp,64000);
  477. end;
  478.  
  479. procedure init;
  480. begin
  481.   virtup;
  482.   frame:=0;
  483.   for i:=0 to 255 do begin
  484.     stab1[i]:=round(sin(i*2*pi/255)*50)+160;
  485.     stab2[i]:=round(cos(i*4*pi/255)*25);
  486.     stab3[i]:=round(sin(i*4*pi/255)*25);
  487.   end;
  488.   fillchar(ctab,sizeof(ctab),0);
  489.   i1:=0; i2:=25; i3:=100;
  490. end;
  491.  
  492. procedure waves;
  493. var x,y:word;
  494. begin
  495.   t1:=timer;
  496.   repeat
  497.     move(ctab,ptab,sizeof(ctab));
  498.     for i:=0 to 44 do
  499.     begin
  500.       ctab[i]:=stab1[(i+i1) mod 255]+stab2[(i+i2) mod 255]+stab3[(i+i3) mod 255];
  501.       hline2(0,ctab[i],i,work,ctab[i]-59);
  502.       hline2(ctab[i],320,i,work,not (ctab[i]-15));
  503.     end;
  504.     i1:=(i1+add1) mod 255; i2:=(i2+add2) mod 255; i3:=(i3+add3) mod 255;
  505.     for i:=0 to 2 do
  506.       smooth2(work,320*44);
  507.     flip386(work,vidseg);
  508.     inc(frame);
  509.   until(keypressed)and(readkey=#27);
  510.   t2:=(timer-t1);
  511. end;
  512.  
  513. procedure main;
  514. begin
  515.   init;
  516.   setmode($13);
  517.   scanlines(8);
  518.   for i:=1 to 199 do setpal(i,i div 4,20+i div 5,10+i div 6);
  519.   waves;
  520.   setmode($03);
  521.   writeln(round((frame*18.2)/t2),' fps.');
  522.   virtdn;
  523. end;
  524.  
  525. begin
  526.   main;
  527. end.
  528.